home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 38 / sgn_bans.zip / SIGNSMIF.PAS < prev    next >
Pascal/Delphi Source File  |  1985-12-17  |  12KB  |  402 lines
  1. { Program SignSmif.Pas  "Sign-Smith" }
  2.  
  3. { Prints signs, overhead masters, and fancy title pages }
  4. { Needs Font1.dat, Font2.dat, Font3.dat, Font4.dat }
  5. { The program EditFont.Pas allows modification of these fonts. }
  6.  
  7. { In the compiler options, A = 4000, i.e.
  8. { 4000 (hex segs) appears to be a suitable max heap size for .COM file }
  9.  
  10. {$I StringOf.Pas }  { generates strings of repeated chars. }
  11. {$I Parse2.Pas   }  { string parser }
  12. {$I Replacec.Pas }  { replace one char by another in string }
  13. {$I Trim.Pas     }  { trims trailing blanks from strings }
  14. {$I Environm.Pas }  { searches environment for wanted item }
  15. {$I PrintPak.Pas }  { include printer procedures & globals }
  16.  
  17. Const
  18.   NumberOfOptions = 4 ;
  19.  
  20. Var
  21.   ch : char ;
  22.   fname : string[30] ;
  23.   keystr : string[6] ;
  24.   datafile : text ;
  25.   tempstr : CardImage ; { type defined in Parse2 }
  26.   SubStr  : StrArray  ; { type defined in Parse2 }
  27.   SubSubStr : StrArray ;
  28.   nsubs, nsubsubs : integer ;
  29.   j,jj,k,mm,n,err : integer ;
  30.   DotRows, DotCols, xloc, yloc, YlocExtra : integer ;
  31.   Between, Font : integer ;
  32.   centre, FirstLine, OffPage, BadFile, FirstTime : boolean ;
  33.   tb : byte ;
  34.  
  35. label ByPassScan, CleanUpAndExit, MoreFiles ;
  36.  
  37. Procedure HandleOneLine(PrePass : Boolean) ;
  38. {
  39. This procedure, internal to main, handles one line of data.
  40. If PrePass is true, merely checks that data line fits on screen.
  41. If PrePass is false, does screen display &/or print.
  42. In Prepass, returns OffPage, a variable in main program
  43. }
  44.  
  45. begin
  46.     OffPage := false ;
  47.     readln(datafile,tempstr) ;
  48.     if FirstLine then { landscape declaration must at start of file }
  49.     begin
  50.       LandScape :=  (tempstr[1] = '\') and (upcase(tempstr[2]) = 'L') ;
  51.       FirstLine := false ; { never check this again }
  52.     end ;
  53.     if tempstr[1] = '\' then
  54.     begin
  55.       Tempstr[1] := ' ' ;
  56.       ReplaceChar(TempStr,',',' ') ; { replace comma by space }
  57.       j := 0 ; { = parse all }
  58.       Parse2(TempStr,SubStr,nsubs,j) ;
  59.       for j := 1 to nsubs do
  60.       begin
  61.         ReplaceChar(SubStr[j],'=',' ') ; { replace = by space }
  62.         k := 2 ;
  63.         Parse2(Substr[j],SubSubStr,nsubsubs,k) ;
  64.         ch := Copy(SubSubStr[1],1,1) ;
  65.         ch := Upcase(ch) ;
  66.         if ch = 'C' then
  67.         begin
  68.          if Copy(SubSubStr[1],2,1) = '-'
  69.            then centre := false
  70.            else centre := true ;
  71.         end { ch = 'C' }
  72.         else
  73.         if ch in ['D','F','K','R','S','X','Y'] then
  74.         begin { should be a numeric argument ... }
  75.           Val(SubSubStr[2],n,err) ;
  76.           if err <> 0 then
  77.           begin
  78.             writeln('Error in ',SubSubStr[2],' within ...') ;
  79.             Writeln(SubStr[j],' within ...') ;
  80.             Writeln(TempStr) ;
  81.             Halt ;
  82.           end
  83.           else
  84.           begin
  85.             case ch of
  86.               'D' : YlocExtra := n ;  { Down }
  87.               'F' : if n in [1..NumberOfFonts] then
  88.                     begin
  89.                       Font := n ;
  90.                       if PrePass then WantFont[n] := true ;
  91.                     end ;
  92.               'K' : DotCols := n ;    { ColSize }
  93.               'R' : DotRows := n ;    { RowSize }
  94.               'S' : Between := n ;    { extra separation between chars }
  95.               'X' : Xloc := n ;
  96.               'Y' : Yloc := n ;
  97.             end ; { case }
  98.           end { else from err <> 0 }
  99.         end ; { get numeric argument }
  100.       end ; { for j }
  101.     end { if line starts with \ }
  102.     else { no leading \ , so this line must be text for printing }
  103.     begin
  104.       j := Trim(TempStr) ; { remove trailing blanks, to avoid mis-centre }
  105.       PutString(TempStr,xloc,yloc,Font,DotCols,DotRows,Between,
  106.                 Centre,PrePass,OffPage) ;
  107.       Yloc := Yloc + YlocExtra ; { add any extra vertical space }
  108.     end ;
  109. end ; { HandleOneLine }
  110.  
  111. begin { *** MAIN PROGRAM *** }
  112.  
  113.   FirstTime := true ;
  114.   CheckTextOnly := false ;
  115.  
  116.   ClrScr ;
  117.   gotoxy(1,5) ;
  118.   TextColor(LightGray) ;
  119.   TextBackground(black) ;
  120.   Write('SignSmif the  ') ;
  121.   TextColor(Black) ;
  122.   TextBackground(LightGray) ;
  123.   write('"Sign-Smith"') ;
  124.   TextColor(LightGray) ;
  125.   TextBackground(Black) ;
  126.   writeln('      Version 1.11') ;
  127.   writeln ;
  128.   writeln('Copyright (C) by Bryan B. Smith, Kingston, Ont., 1985') ;
  129.   writeln ;
  130.   writeln('All Rights Reserved.') ;
  131.   { Version 1.11, about 1/5 reduction in time to create printer bit map by
  132.   { putting "change" code in printpak in-line, 1/4 in screen draw time. }
  133.   writeln ;
  134.   writeln('This program may be copied and distributed on a ',
  135.              'non-profit basis.') ;
  136.   writeln ;
  137.   delay(1500) ;
  138.  
  139. MoreFiles : { in "C" mode, program loops back to here }
  140.  
  141.   { If user gave us a file name, check it out before loading fonts ...}
  142.   if (ParamCount > 0) and FirstTime then { If file name was on command line }
  143.   begin
  144.     fname := ParamStr(1) ;
  145.     { add default extension if needed ... }
  146.     if pos('.',fname) = 0 then fname := fname + '.sgn' ;
  147.     assign(datafile,fname) ;
  148.     {$I-}
  149.     reset(datafile) ;
  150.     {$I+}
  151.     j := IOresult ;
  152.     if j <> 0 then
  153.     begin
  154.       write('File ',fname,' not found.') ;
  155.       halt ;
  156. {
  157.     end
  158.     else
  159.     begin
  160. }
  161.     end ;
  162.   end { if (ParamCount }
  163.   else
  164.   begin { no file name on command line }
  165.     write('Enter name of your') ;
  166.     repeat
  167.       writeln(' data file or enter Q to quit  ') ;
  168.       write('The default extension is .sgn   ') ;
  169.       readln(fname) ;
  170.       if (length(fname) = 1) and (upcase(fname[1])='Q') then halt ;
  171.       if pos('.',fname) = 0 then fname := fname + '.sgn' ;
  172.       assign(datafile,fname) ;
  173.       {$I-}
  174.       reset(datafile) ;
  175.       {$I+}
  176.       j := IOresult ;
  177.       if j <> 0 then write('File not found.  Re-enter name of') ;
  178.     until j = 0 ;
  179.   end ;
  180.   FirstTime := false ;
  181.   if ParamCount > 1 then
  182.   begin
  183.     KeyStr := ParamStr(2) ;
  184.   end { if ParamCount }
  185.   else { option not on command line }
  186.   if not CheckTextOnly then
  187.   begin
  188.     ClrScr ;
  189.     writeln ;
  190.     writeln('Your Options now are ...') ;
  191.     writeln ;
  192.     writeln('    P to printout.') ;
  193.     writeln('    S to show on screen.') ;
  194.     writeln('    N for No-grid.') ;
  195.     writeln('    F to do fast screen-show of first letters only, no print.') ;
  196.     writeln('    C for text check only - no screen display, no print.') ;
  197.     writeln ;
  198.     write('Enter codes for your choice, e.g. SPN, or <return> for SP   ') ;
  199.     readln(KeyStr) ;
  200.   end ; { else }
  201.  
  202.   if length(KeyStr) = 0 then KeyStr := 'SP' ;
  203.  
  204.   WantScreen := false ;
  205.   WantPrint := false ;
  206.   FirstCharOnly := false ;
  207.   CheckTextOnly := false ;
  208.   grid := true ;
  209.  
  210.   for j := 1 to length(KeyStr) do
  211.   begin
  212.     ch := upcase(KeyStr[j]) ;
  213.     case ch of
  214.       'S' : WantScreen := true ;
  215.       'P' : WantPrint := true ;
  216.       'N' : grid := false ;
  217.       'C' : begin                   { C over-rides all other specs. }
  218.               WantScreen := false ;
  219.               WantPrint := false ;
  220.               CheckTextOnly := true ;
  221.               goto ByPassScan ;
  222.             end ; { 'C' }
  223.       'F' : begin                   { F over-rides all other specs. }
  224.               WantScreen := true ;
  225.               WantPrint := false ;
  226.               FirstCharOnly := true ;
  227.               grid := true ;
  228.               goto ByPassScan ;
  229.             end ; { 'F' }
  230.     end ; { case }
  231.   end ; { for j }
  232.  
  233. ByPassScan :
  234.   { start pre-check of file ... }
  235.  
  236.   for j := 1 to NumberOfFonts do WantFont[j] := false ;
  237.  
  238.   centre := false ;  { set default values ... }
  239.   Xloc := 1 ;    { user's x & y start at 1, programs at 0 }
  240.   Yloc := 100 ;
  241.   Font := 2 ;
  242.   DotCols := 4 ;
  243.   DotRows := 2 ;
  244.   YlocExtra := 0 ;
  245.   Between := 0 ;
  246.  
  247.   BadFile := false ;
  248.   FirstLine := true ;
  249.  
  250.   while not EOF(datafile) do
  251.   begin
  252.     HandleOneLine(true) ; { internal procedure : PrePass is True } ;
  253.     BadFile := BadFile or OffPage ; { update BadFile }
  254.   end ; { while not EOF }
  255.  
  256.   if CheckTextOnly
  257.   then
  258.   begin
  259.     writeln ;
  260.     write('End of checkout of file ') ;
  261.     TextColor(White) ;
  262.     writeln(fname) ;
  263.     TextColor(LightGray) ;
  264.     writeln('If no error messages were printed, this file will ',
  265.              'fit on the page.') ;
  266.     writeln('You may continue with the checkout of another file.') ;
  267.     writeln ;
  268.     goto MoreFiles ; { warning - backwards jump }
  269.   end
  270.   else
  271.   begin
  272.     If Badfile then
  273.     begin
  274.       writeln ;
  275.       writeln('Due to above errors, will not do screen and/or printing.') ;
  276.       writeln ;
  277.       halt ;
  278.     end ; { if Bad }
  279.   end ; { else }
  280.   reset(datafile) ;
  281.  
  282.   Init_PrintPak ;
  283.   writeln ;
  284.   writeln('Please remember ...') ;
  285.   writeln ;
  286.   {       '    Press any LETTER key to STOP program.' }
  287.   {        1234                        1234 }
  288.   {            123456789012345678901234    123456789 }
  289.   write('    Press any LETTER key to ') ;
  290.   textcolor(white) ;
  291.   write('STOP') ;
  292.   textcolor(LightGray) ;
  293.   writeln(' program.') ;
  294.   write('':4,StringOf(24,#196)) ; { #196 = horizontal single line }
  295.   textcolor(white+Blink) ;
  296.   write(stringof(4,#196)) ;
  297.   textcolor(LightGray) ;
  298.   writeln(Stringof(9,#196)) ;
  299.   delay(2000) ;
  300.  
  301.   if WantScreen then
  302.   begin
  303.     HiRes; HiResColor(7) ; { draw in 640- * 200- dot mode }
  304.     if grid then DrawGrid ;
  305.   end ;
  306.  
  307.   centre := false ;  { set default values ... }
  308.   Xloc := 1 ;    { user's x & y start at 1, programs at 0 }
  309.   Yloc := 100 ;
  310.   Font := 2 ;
  311.   DotCols := 4 ;
  312.   DotRows := 2 ;
  313.   YlocExtra := 0 ;
  314.   Between := 0 ;
  315.  
  316.   FirstLine := true ;
  317.  
  318.   while not EOF(datafile) do
  319.   begin
  320.     HandleOneLine(false) ;  { internal procedure, & not a Pre-Pass }
  321.   end ; { while not EOF }
  322.  
  323.   if not WantScreen then ClrScr ; { get rid of text (but not graphics) }
  324.  
  325.   if not WantPrint then  { it's time to quit }
  326.   begin
  327.     gotoxy(1,1) ;
  328.     write('Press any letter to exit.  ') ;
  329.     repeat until keypressed ;
  330.     read(KBD,ch) ;
  331.     Goto CleanUpAndExit ;
  332.   end ;
  333.  
  334.   if WantPrint and (not WantScreen) and (ParamCount > 2) then
  335.   { user wants print only, and specified left margin on command line }
  336.   begin
  337.     Val(ParamStr(3),leftmarg,j) ;
  338.   end
  339.   else { ask user for left margin }
  340.   begin
  341.     repeat
  342.       gotoxy(52,1) ;  { clear space for ans }
  343.       write('':3) ;
  344.       gotoxy(1,1) ;
  345.       write('Print or Quit (grid dots don''t print)  ? (p or q)  ') ;
  346.       {      12345678901234567890123456789 01234567890123456789012 }
  347.       readln(ch) ;
  348.       ch := UpCase(ch) ;
  349.     until ch in ['P','Q'] ;
  350.  
  351.     if ch = 'Q' then goto CleanUpAndExit ;
  352.  
  353.     repeat
  354.       gotoxy(1,1) ;
  355.       writeln('Enter extra left margin width, spaces.  Usual is 7     ') ;
  356.       gotoxy(19,2) ;
  357.       write('':2) ;
  358.       gotoxy(1,2) ;
  359.       write('O.K. to enter 0   ') ;
  360.       {      1234567890123456789 }
  361.       {$I-}
  362.       readln(leftmarg) ;
  363.       {$I+}
  364.     until IOresult = 0 ;
  365.   end ; { ask user }
  366.  
  367.   Printout ;
  368.  
  369.   { Print-it-again section - bypass if left margin was in command line }
  370.   if ParamCount <= 2 then { no user-specified left margin on command line }
  371.   begin
  372.     repeat
  373.       repeat
  374.         gotoxy(1,1) ;
  375.         writeln('Enter new left margin to re-print with a ',
  376.                           'different left margin') ;
  377.         gotoxy(23,2) ;
  378.         write('':2) ;
  379.         gotoxy(1,2) ;
  380.         write('or enter -1 to quit.  ') ;
  381.         {      1234567890123456789012 }
  382.         {$I-}
  383.         readln(LeftMarg) ;
  384.         {$I+}
  385.       until IOresult = 0 ;
  386.       if LeftMarg >= 0 then
  387.       begin
  388.         gotoxy(1,1) ;
  389.         writeln('Press space bar when printer ready.','':27) ;
  390.         write('':75) ;
  391.         repeat until keypressed ;
  392.         Read(KBD,ch) ;
  393.         Printout ;
  394.       end ; { if LeftMarg }
  395.     until LeftMarg < 0 ;
  396.   end ; { if ParamCount }
  397.  
  398. CleanUpAndExit :
  399.   TextMode(BW80) ;
  400.   ClrScr ;
  401.  
  402. end .